;; C code generators

(defun c-block-size (block)
  (let* ((size 0) 
    (var-index 0)
    (declarations "")
    (body
      (with-output-to-string (s)
        (dolist (var-data (block-vars block))
          (cond
            ((eq (var-type var-data) '|Variable|)
              ;; We need a special case for variables with variable length (Strings)
              (let ((s-sofar (get-output-stream-string s)))
                (cond
                  ((> (length s-sofar) 0)
                    (setf declarations (format nil "~aoff~a = ~a;~%" declarations var-index s-sofar))
                    (setf s-sofar (format nil "off~a" var-index))
                    (setf var-index (+ 1 var-index))
                    (format s "~a+" s-sofar)))
                (format s "~a+" (+ size (var-type-arg var-data)))
                (ecase (var-type-arg var-data)
                  (1
                    (if (> (length s-sofar) 0) (format s "data[n+~a+~a]" s-sofar size) (format s "data[n+~a]" size)))
                  (2
                    (if (> (length s-sofar) 0)
                      (format s "(data[n+~a+~a]+(data[n+~a+~a]<<8))" s-sofar size s-sofar (+ 1 size))
                      (format s "(data[n+~a]+(data[n+~a]<<8))" size (+ 1 size)))))
                (setf size 0)))
            (t (incf size (var-size var-data)))))))
    (src-declarations
      (with-output-to-string (s)
        (format s "int off") (dotimes (i var-index) (format s ", off~a" i)) (format s ";")))
    (src-body
      (with-output-to-string (s)
        (if (> (length body) 0)
          (format s "~a off=~a+~a" declarations body size)
          (format s "~a off=~a" declarations size)))))
    (values src-declarations src-body)))


(defun c-declare-variable (var-data)
  (let ((n (var-name var-data)))
    (ecase (var-type var-data)
      (|BOOL| (format nil "int ~a" n))
      (|Fixed| (format nil "unsigned char* ~a" n))
      (|U16| (format nil "unsigned short ~a" n))
      (|S16| (format nil "short ~a" n))
      (|U64| (format nil "ULONGLONG ~a" n))
      (|LLVector3| (format nil "float x~a, float y~a, float z~a" n n n))
      (|LLVector4| (format nil "float x~a, float y~a, float z~a, float s~a" n n n n))
      (|LLVector3d| (format nil "double x~a, double y~a, double z~a" n n n))
      (|LLQuaternion| (format nil "float x~a, float y~a, float z~a, float w~a" n n n n))
      (|Variable| (format nil "char* ~a" n))
      (|LLUUID| (format nil "char* ~a" n))
      (|IPADDR| (format nil "unsigned int ~a" n))
      (|IPPORT| (format nil "unsigned short ~a" n))
      (|F32| (format nil "float ~a" n))
      (|F64| (format nil "double ~a" n))
      (|S8| (format nil "char ~a" n))
      (|S32| (format nil "int ~a" n))
      (|U8| (format nil "unsigned char ~a" n))
      (|U32| (format nil "unsigned int ~a" n)))))

(defun c-declare-ref-variable (var-data)
  (let ((n (var-name var-data)))
    (ecase (var-type var-data)
      (|BOOL| (format nil "int* ~a" n))
      (|Fixed| (format nil "unsigned char* ~a" n))
      (|U16| (format nil "unsigned short* ~a" n))
      (|S16| (format nil "short* ~a" n))
      (|U64| (format nil "ULONGLONG* ~a" n))
      (|LLVector3| (format nil "float* x~a, float* y~a, float* z~a" n n n))
      (|LLVector4| (format nil "float* x~a, float* y~a, float* z~a, float *s~a" n n n n))
      (|LLVector3d| (format nil "double* x~a, double* y~a, double* z~a" n n n))
      (|LLQuaternion| (format nil "float* x~a, float* y~a, float* z~a, float* w~a" n n n n))
      (|Variable| (format nil "char* ~a" n))
      (|LLUUID| (format nil "char* ~a" n))
      (|IPADDR| (format nil "unsigned int* ~a" n))
      (|IPPORT| (format nil "unsigned short* ~a" n))
      (|F32| (format nil "float* ~a" n))
      (|F64| (format nil "double* ~a" n))
      (|S8| (format nil "char* ~a" n))
      (|S32| (format nil "int* ~a" n))
      (|U8| (format nil "unsigned char* ~a" n))
      (|U32| (format nil "unsigned int* ~a" n)))))

(defun c-variable-to-udp (var-data)
  (let ((n (var-name var-data)))
    (ecase (var-type var-data)
      (|BOOL| (format nil "Bool_UDP(~a, data, &n)" n))
      (|Fixed| (format nil "Fixed_UDP(~a, ~a, data, &n)" n(var-type-arg var-data)))
      (|U16| (format nil "U16_UDP(~a, data, &n)" n))
      (|S16| (format nil "S16_UDP(~a, data, &n)" n))
      (|U64| (format nil "U64_UDP(~a, data, &n)" n))
      (|LLVector3| (format nil "LLVector3_UDP(x~a, y~a, z~a, data, &n)" n n n))
      (|LLVector4| (format nil "LLVector4_UDP(x~a, y~a, z~a, s~a, data, &n)" n n n n))
      (|LLVector3d| (format nil "LLVector3d_UDP(x~a, y~a, z~a, data, &n)" n n n))
      (|LLQuaternion| (format nil "LLQuaternion_UDP(x~a, y~a, z~a, w~a, data, &n)" n n n n))
      (|Variable|
       (ecase (var-type-arg var-data)
         (1 (format nil "Variable1_UDP(~a, data, &n)" n))
         (2 (format nil "Variable2_UDP(~a, data, &n)" n))))
      (|LLUUID| (format nil "LLUUID_UDP(~a, data, &n)" n))
      (|IPADDR| (format nil "U32_UDP(~a, data, &n)" n))
      (|IPPORT| (format nil "IPPORT_UDP(~a, data, &n)" n))
      (|F32| (format nil "F32_UDP(~a, data, &n)" n))
      (|F64| (format nil "F64_UDP(~a, data, &n)" n))
      (|S8| (format nil "S8_UDP(~a, data, &n)" n))
      (|S32| (format nil "S32_UDP(~a, data, &n)" n))
      (|U8| (format nil "U8_UDP(~a, data, &n)" n))
      (|U32| (format nil "U32_UDP(~a, data, &n)" n)))))

(defun c-variable-from-udp (var-data)
  (let ((n (var-name var-data)))
    (ecase (var-type var-data)
      (|BOOL| (format nil "UDP_Bool(~a, data, &n)" n))
      (|Fixed| (format nil "UDP_Fixed(~a, ~a, data, &n)" n(var-type-arg var-data)))
      (|U16| (format nil "UDP_U16(~a, data, &n)" n))
      (|S16| (format nil "UDP_S16(~a, data, &n)" n))
      (|U64| (format nil "UDP_U64(~a, data, &n)" n))
      (|LLVector3| (format nil "UDP_LLVector3(x~a, y~a, z~a, data, &n)" n n n))
      (|LLVector4| (format nil "UDP_LLVector4(x~a, y~a, z~a, s~a, data, &n)" n n n n))
      (|LLVector3d| (format nil "UDP_LLVector3d(x~a, y~a, z~a, data, &n)" n n n))
      (|LLQuaternion| (format nil "UDP_LLQuaternion(x~a, y~a, z~a, w~a, data, &n)" n n n n))
      (|Variable|
       (ecase (var-type-arg var-data)
         (1 (format nil "UDP_Variable1(~a, data, &n)" n))
         (2 (format nil "UDP_Variable2(~a, data, &n)" n))))
      (|LLUUID| (format nil "UDP_LLUUID(~a, data, &n)" n))
      (|IPADDR| (format nil "UDP_U32(~a, data, &n)" n))
      (|IPPORT| (format nil "UDP_IPPORT(~a, data, &n)" n))
      (|F32| (format nil "UDP_F32(~a, data, &n)" n))
      (|F64| (format nil "UDP_F64(~a, data, &n)" n))
      (|S8| (format nil "UDP_S8(~a, data, &n)" n))
      (|S32| (format nil "UDP_S32(~a, data, &n)" n))
      (|U8| (format nil "UDP_U8(~a, data, &n)" n))
      (|U32| (format nil "UDP_U32(~a, data, &n)" n)))))

(defun c-random-value-size (var-data)
  (ecase (var-type var-data)
    (|BOOL| 1)
    (|Fixed| 0)
    (|U16| 1)
    (|S16| 1)
    (|U64| 1)
    (|LLVector3| 3)
    (|LLVector4| 4)
    (|LLVector3d| 3)
    (|LLQuaternion| 4)
    (|Variable| 0)
    (|LLUUID| 1)
    (|IPADDR| 1)
    (|IPPORT| 1)
    (|F32| 1)
    (|F64| 1)
    (|S8| 1)
    (|S32| 1)
    (|U8| 1)
    (|U32| 1)))

(defun c-random-value (var-data var-index)
  (ecase (var-type var-data)
    (|BOOL| (format nil "(v[~a]==0)" var-index))
    (|Fixed| (format nil "va"))
    (|U16| (format nil "(unsigned short) v[~a]" var-index))
    (|S16| (format nil "(short) v[~a]" var-index))
    (|U64| (format nil "(ULONGLONG) v[~a]" var-index))
    (|LLVector3| (format nil "v[~a], v[~a], v[~a]" var-index (+ 1 var-index) (+ 2 var-index)))
    (|LLVector4| (format nil "v[~a], v[~a], v[~a], v[~a]" var-index (+ 1 var-index) (+ 2 var-index) (+ 3 var-index)))
    (|LLVector3d| (format nil "v[~a], v[~a], v[~a]" var-index (+ 1 var-index) (+ 2 var-index)))
    (|LLQuaternion| (format nil "v[~a], v[~a], v[~a], v[~a]" var-index (+ 1 var-index) (+ 2 var-index) (+ 3 var-index)))
    (|Variable| (format nil "vs"))
    (|LLUUID| (format nil "UUIDFromU64((unsigned long) v[~a])" var-index))
    (|IPADDR| (format nil "(unsigned int)  v[~a]" var-index))
    (|IPPORT| (format nil "(unsigned short) (v[~a]%65536)" var-index))
    (|F32| (format nil "(float)  v[~a]" var-index))
    (|F64| (format nil "(double)  v[~a]" var-index))
    (|S8| (format nil "(char) (v[~a]%256-128)" var-index))
    (|S32| (format nil "v[~a]" var-index))
    (|U8| (format nil "(unsigned char) (v[~a]%256)" var-index))
    (|U32| (format nil "(unsigned int) v[~a]" var-index))))

(defun c-packet-size (size)
  ;; Size is a list block sizes, either integers (for Single/Multiple blocks), or a tuple (integer) for Variable
  (with-output-to-string (s)
    (format s "int n=~a;" (first size)) ;; header size
    (dolist (b (rest size))
      (cond
        ((listp b) (format s "n+=1+((int) data[n])*~a;" (first b)))
        (t (format s "n+=~a;" b))))))
  
(defun c-calculate-offset (s packet block-name)
  (format s "  int n=~a;~%" (packet-header-size packet))
  (dolist (block (packet-blocks packet))
    (if (string= block-name (block-name block)) (return))
    (format s "  n+=~a_~a_Length(data);~%" (packet-name packet) (block-name block))))

(defun c-header-flags (packet)
  (with-output-to-string (s)
    (format s "0")
    ;; There is no way to say from the template file if a message is reliable or not
    ;; (It is not using the Trusted/NotTrusted flag)
    ;; We have to assume that the program is setting RELIABLE using the SetReliable method)
    ;;(format s "Header.RELIABLE")
    (if (packet-zerocoded? packet) (format s "|ZEROCODED"))))

(defun c-packet-enums (parse-tree)
  "Create enums for all packet functions"
  (let ((indent ""))
    (with-output-to-string (s)
      (format s "~aenum PacketType~%" indent)
      (format s "~a{~%" indent )
      (dolist (packet parse-tree)
        (case (packet-header-type packet)
          (|Low| (format s "~a    ~a = ~a,~%"  indent (packet-name packet) (+ #x10000 (packet-number packet))))
          (|Medium| (format s "~a    ~a = ~a,~%" indent (packet-name packet) (+ #x20000 (packet-number packet))))
          (|High| (format s "~a    ~a = ~a,~%" indent (packet-name packet) (+ #x30000 (packet-number packet))))))
      (format s "~a};~%" indent))))

(defun c-packet-enum-function (parse-tree)
  "Create GetType"
  (let ((indent ""))
    (with-output-to-string (s)
      (format s "~aint GetType(unsigned char *data)~%" indent)
      (format s "~a{~%" indent )
      (dolist (packet parse-tree)
        (format s "~a    if(GetPacketFrequency(data)==~a && GetPacketID(data)==~a) return ~a;~%"
                indent (packet-header-type packet) (packet-number packet) (packet-name packet)))
      (format s "~a    printf(\"Unknown packet in PacketType\\n\"); exit(-1);~%" indent)
      (format s "~a}~%" indent))))

(defun c-packet-udp-functions (parse-tree)
  "create source code for the <packet>_UDP functions"
  (with-output-to-string (s)
    (dolist (packet parse-tree)
      (format t "Creating ~a ~a (c version)~%" (packet-name packet) (packet-number packet))
      (let ((header-size (packet-header-size packet)))
        (format s "void ~aHeader(unsigned char* data)~%{ Header_UDP(data, ~a, ~a, ~a); }~%"
                (packet-name packet) (packet-number packet) (packet-header-type packet) (c-header-flags packet))
        (dolist (block (packet-blocks packet))
          (multiple-value-bind (declarations body) (c-block-size block)
            (case (block-type block)
              (|Variable|
               (format s "void ~a_~aBlockSize(unsigned char* data, unsigned int length)~%{~%" (packet-name packet) (block-name block))
               (c-calculate-offset s packet (block-name block))
               (format s "  data[n]=(char) length;~%}~%")
               (format s "void ~a_~aBlock(unsigned char* data, int index" (packet-name packet) (block-name block))
               (dolist (var (block-vars block)) (format s ", ~a" (c-declare-variable var)))
               (format s ")~%{~%  int j;~%  ~a~%" declarations)
               (c-calculate-offset s packet (block-name block))
               (format s "  n+=1; for(j=0; j<index; j++) { ~a; n+=off; }~%"  body)
               (dolist (var (block-vars block)) (format s "  ~a;~%" (c-variable-to-udp var)))
               (format s "}~%")
               (format s "int Get_~a_~aBlockSize(unsigned char* data)~%{~%" (packet-name packet) (block-name block))
               (c-calculate-offset s packet (block-name block))
               (format s "  return (int) data[n];~%}~%")
               (format s "void Get_~a_~aBlock(unsigned char* data, int index" (packet-name packet) (block-name block))
               (dolist (var (block-vars block)) (format s ", ~a" (c-declare-ref-variable var)))
               (format s ")~%{~%  int j;~%  ~a~%" declarations)
               (c-calculate-offset s packet (block-name block))
               (format s "  n+=1; for(j=0; j<index; j++) { ~a; n+=off; }~%"  body)
               (dolist (var (block-vars block)) (format s "  ~a;~%" (c-variable-from-udp var)))
               (format s "}~%")
               (format s "int ~a_~a_Length(unsigned char* data)~%{~%  int j, x, l;~%  ~a~%" (packet-name packet) (block-name block) declarations)
               (c-calculate-offset s packet (block-name block))
               (format s "  x=n; l=(int) data[n++];~%  for(j=0; j<l; j++) { ~a; n+=off; }~%  return n-x;~%}~%"  body))
              (|Single|
               (format s "void ~a_~a(unsigned char* data" (packet-name packet) (block-name block))
               (dolist (var (block-vars block)) (format s ", ~a" (c-declare-variable var)))
               (format s ")~%{~%")
               (c-calculate-offset s packet (block-name block))
               (dolist (var (block-vars block)) (format s "  ~a;~%" (c-variable-to-udp var)))
               (format s "}~%")
               (format s "void Get_~a_~a(unsigned char* data" (packet-name packet) (block-name block))
               (dolist (var (block-vars block)) (format s ", ~a" (c-declare-ref-variable var)))
               (format s ")~%{~%")
               (c-calculate-offset s packet (block-name block))
               (dolist (var (block-vars block)) (format s "  ~a;~%" (c-variable-from-udp var)))
               (format s "}~%")
               (format s "int ~a_~a_Length(unsigned char* data)~%{~%  int x;~%  ~a~%" (packet-name packet) (block-name block) declarations)
               (c-calculate-offset s packet (block-name block))
               (format s "  x=n; ~a; n+=off; return n-x;~%}~%" body))
              (|Multiple|
               (format s "void ~a_~a(unsigned char* data, int index" (packet-name packet) (block-name block))
               (dolist (var (block-vars block)) (format s ", ~a" (c-declare-variable var)))
               (format s ")~%{~%  ~a~%" declarations)
               (c-calculate-offset s packet (block-name block))
               (format s "  ~a; n+=index*off;" body)
               (dolist (var (block-vars block)) (format s "  ~a;~%" (c-variable-to-udp var)))
               (format s "}~%")
               (format s "void Get_~a_~a(unsigned char* data, int index" (packet-name packet) (block-name block))
               (dolist (var (block-vars block)) (format s ", ~a" (c-declare-ref-variable var)))
               (format s ")~%{~%  ~a~%" declarations)
               (c-calculate-offset s packet (block-name block))
               (format s "  ~a; n+=index*off;" body)
               (dolist (var (block-vars block)) (format s "  ~a;~%" (c-variable-from-udp var)))
               (format s "}~%")
               (format s "int ~a_~a_Length(unsigned char* data)~%{~%  int x;~%  ~a~%" (packet-name packet) (block-name block) declarations)
               (c-calculate-offset s packet (block-name block))
               (format s "  x=n; ~a; n+=~a*off; return n-x;~%}~%" body (block-cardinality block))))))
        (format s "int ~aLength(unsigned char* data)~%{~%" (packet-name packet))
        (c-calculate-offset s packet "")
        (format s "  return n;~%}~%")))))

(defun c-packet-headers (parse-tree)
  "create declarations for the <packet>_UDP functions"
  (with-output-to-string (s)
    (dolist (packet parse-tree)
      (format s "void ~aHeader(unsigned char* data);~%" (packet-name packet))
      (dolist (block (packet-blocks packet))
        (case (block-type block)
          (|Variable|
           (format s "void ~a_~aBlockSize(unsigned char* data, unsigned int length);~%" (packet-name packet) (block-name block))
           (format s "void ~a_~aBlock(unsigned char* data, int index" (packet-name packet) (block-name block))
           (dolist (var (block-vars block)) (format s ", ~a" (c-declare-variable var)))
           (format s ");~%")
           (format s "int Get_~a_~aBlockSize(unsigned char* data);~%" (packet-name packet) (block-name block))
           (format s "void Get_~a_~aBlock(unsigned char* data, int index" (packet-name packet) (block-name block))
           (dolist (var (block-vars block)) (format s ", ~a" (c-declare-ref-variable var)))
           (format s ");~%")
           (format s "int ~a_~a_Length(unsigned char* data);~%" (packet-name packet) (block-name block)))
          (|Single|
           (format s "void ~a_~a(unsigned char* data" (packet-name packet) (block-name block))
           (dolist (var (block-vars block)) (format s ", ~a" (c-declare-variable var)))
           (format s ");~%")
           (format s "void Get_~a_~a(unsigned char* data" (packet-name packet) (block-name block))
           (dolist (var (block-vars block)) (format s ", ~a" (c-declare-ref-variable var)))
           (format s ");~%")
           (format s "int ~a_~a_Length(unsigned char* data);~%" (packet-name packet) (block-name block)))
          (|Multiple|
           (format s "void ~a_~a(unsigned char* data, int index" (packet-name packet) (block-name block))
           (dolist (var (block-vars block)) (format s ", ~a" (c-declare-variable var)))
           (format s ");~%")
           (format s "void Get_~a_~a(unsigned char* data, int index" (packet-name packet) (block-name block))
           (dolist (var (block-vars block)) (format s ", ~a" (c-declare-ref-variable var)))
           (format s ");~%")
           (format s "int ~a_~a_Length(unsigned char* data);~%" (packet-name packet) (block-name block)))))
      (format s "int ~aLength(unsigned char* data);~%" (packet-name packet)))))

(defun c-unittest-functions (parse-tree) 
  (with-output-to-string (s)
    (dolist (packet parse-tree)
      (let ((name (packet-name packet))
            (var-index 0))
        (format s "static void Test~a()~%{~%" (packet-name packet))
        (format s "  int x, i, j;~%")
        (format s "  unsigned char msg2[1024];~%")
        (format s "  FILE *s=fopen(\"~a.log\", \"r\");~%" (packet-name packet))
        ;(format s "  printf(\"  ~a...\\n\");~%" name)
        (format s "  ~aHeader(msg2);~%" name)
        (dolist (block (packet-blocks packet))
          (ecase (block-type block)
            (|Variable|
              (format s "  ~a_~aBlockSize(msg2, 5);~%" name (block-name block))
              (format s "  for(i=0; i<5;i++) {~%")
              (format s "    for(j=0; j<~a; j++) v[j]=GetTestValue(s);~%" (reduce #'+ (mapcar #'c-random-value-size (block-vars block))))
              (format s "    ~a_~aBlock(msg2, i" name (block-name block))
              (setf var-index 0) (dolist (var (block-vars block)) (format s ", ~a" (c-random-value var var-index)) (incf var-index (c-random-value-size var)))
              (format s ");~%  }~%"))
            (|Single|
              (format s "    for(j=0; j<~a; j++) v[j]=GetTestValue(s);~%" (reduce #'+ (mapcar #'c-random-value-size (block-vars block))))
              (format s "  ~a_~a(msg2" name (block-name block))
              (setf var-index 0) (dolist (var (block-vars block)) (format s ", ~a" (c-random-value var var-index)) (incf var-index (c-random-value-size var)))
              (format s ");~%"))
            (|Multiple|
              (format s "  for(i=0; i<~a;i++) {~%" (block-cardinality block))
              (format s "    for(j=0; j<~a; j++) v[j]=GetTestValue(s);~%" (reduce #'+ (mapcar #'c-random-value-size (block-vars block))))
              (format s "    ~a_~a(msg2, i" name (block-name block))
              (setf var-index 0) (dolist (var (block-vars block)) (format s ", ~a" (c-random-value var var-index)) (incf var-index (c-random-value-size var)))
              (format s ");~%  }~%"))))
        (format s "  for (i = 0; i < ~aLength(msg2); i++) {~%" (packet-name packet))
        (format s "   fscanf(s, \"%d\", &x);~%")
        (format s "    if (msg2[i] != x) {~%")
        (format s "      printf(\"Error in %d: %d %d\\n\", i, x, msg2[i]); exit(-1);~%")
        (format s "    }~%")
        (format s "  }~%")
        (format s "  fclose(s);~%}~%")))))

(defun c-unittest-function-calls (parse-tree) 
  (with-output-to-string (s)
    (dolist (packet parse-tree)
      (format s "Test~A();~%" (packet-name packet)))))

(defun make-c-code(parse-tree)
  (let ((packet-template (read-file "template.c"))
        (unittest-template (read-file "template-unittest.c"))
        (headerfile-template (read-file "template.h"))
        (enums (c-packet-enums parse-tree))
        (enum-function (c-packet-enum-function parse-tree))
        (packet-functions (c-packet-udp-functions parse-tree))
        (packet-headers (c-packet-headers parse-tree))
        (unittest-functions (c-unittest-functions parse-tree))
        (unittest-function-calls (c-unittest-function-calls parse-tree)))
    (with-open-file (f "funsl.c" :direction :output :if-exists :supersede)
      (setf packet-template (replace-all packet-template "%PACKETS%" packet-functions))
      (setf packet-template (replace-all packet-template "%ENUMFUNCTION%" enum-function))
      (princ packet-template f))
    (with-open-file (f "funsl.h" :direction :output :if-exists :supersede)
      (setf headerfile-template (replace-all headerfile-template "%PACKETS%" packet-headers))
      (setf headerfile-template (replace-all headerfile-template "%ENUMS%" enums))
      (princ headerfile-template f))
    (with-open-file (f "funsl-unittest.c" :direction :output :if-exists :supersede)
      (setf unittest-template (replace-all unittest-template "%UNITTESTS%" unittest-functions))
      (setf unittest-template (replace-all unittest-template "%UNITTESTLIST%" unittest-function-calls))
      (princ unittest-template f))))

